We downloaded data from Census.gov using the get_acs function, did some data wrangling and cleaning, wrote them as a csv file so that we can import them into RMarkdown
#code_folding: "hide" (hides the code but ppl can see the code if they want to)
knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE) #doesn't show the messages or the warings, only code output, must be its in own code chunk to apply to all the subsequent ones
Petersburg, Hopewell, Charlottesville and Richmond have the highest percentage of renters (overall). Below is a table of the dempographics of renters in each county.
Tenure_By_Race_Perc <- Tenure_By_Race %>%
mutate(Perc_rentersE = (RentersE/Total_OccupantsE), Perc_ownersE = (OwnersE/Total_OccupantsE)) %>%
group_by(County) %>%
summarize(Renters = median(Perc_rentersE, na.rm = TRUE), Owners = median(Perc_ownersE, na.rm = TRUE), White_Renters = median((White_rentersE/RentersE), na.rm = TRUE), White_Owners = median((White_ownersE/OwnersE), na.rm = TRUE), Black_Renters = median((Black_rentersE/RentersE), na.rm = TRUE), Black_Owners = median((Black_ownersE/OwnersE), na.rm = TRUE), NativeAm_Owners = median((NativeAm_ownersE/OwnersE), na.rm = TRUE), NativeAm_Renters = median((NativeAm_rentersE/RentersE), na.rm = TRUE), Asian_Owners = median((Asian_ownersE/OwnersE), na.rm = TRUE), Asian_Renters = median((Asian_rentersE/RentersE), na.rm = TRUE), PacificIslander_Owners = median((PacificIslander_ownerE/OwnersE), na.rm = TRUE), PacificIslander_Renters = median((PacificIslander_renterE/RentersE), na.rm = TRUE), HispanicLatino_Owners = median((HispanicLatino_ownerE/OwnersE), na.rm = TRUE), HispanicLatino_Renters = median((HispanicLation_renterE/RentersE), na.rm = TRUE)) %>%
mutate(across(c(2:14), scales::percent)) %>%
arrange(desc(Renters)) %>%
select(1:3,4,6,9,11,13,15,5,7,8,10,12,14)
sketch = htmltools::withTags(table(
class = 'display',
thead(
tr(
th(rowspan = 2, 'County'),
th(colspan = 6, 'Renters'),
th(colspan = 6, 'Owners')
),
tr(
lapply(c('White_Renters', 'Black_Renters', 'NativeAm_Renters', 'Asian_Renters', "PacificIslander_Renters", "HispanicLatino_Renters", 'White_Owners', 'Black_Owners', 'NativeAm_Owners', 'Asian_Owners', "PacificIslander_Owners", "HispanicLatino_Owners"), th)
)
)
))
DT_Tenure_By_Race <- Tenure_By_Race_Perc[,c(1,4:15)]
datatable(DT_Tenure_By_Race,
caption = htmltools::tags$caption(
style = 'caption-side: bottom; text-align: center;',
'Table 1: ', htmltools::em('Median Percentage of Renters and Owners in Each County (by Demographics)')),
container = sketch,
rownames = FALSE,
extensions = 'Buttons',
options = list(dom='Bfrtip',
buttons=c('copy', 'csv', 'excel', 'print', 'pdf')
)
)
We also graphed the racial composition of renters, comparing Charlottesville and Richmond.
Tenure_perc_by_race <- Tenure_By_Race %>%
mutate(Perc_WRenters = (White_rentersE/RentersE), Perc_WOwners = (White_ownersE/OwnersE), Perc_BRenters = (Black_rentersE/RentersE), Perc_BOwners = (Black_ownersE/OwnersE), Perc_NativeAmOwners = (NativeAm_ownersE/OwnersE), Perc_NativeAmRenters = (NativeAm_rentersE/RentersE), Perc_AsianOwners = (Asian_ownersE/OwnersE), Perc_AsianRenters = (Asian_rentersE/RentersE), Perc_PacificIslanderOwner = (PacificIslander_ownerE/OwnersE), Perc_PacificIslanderRenter = (PacificIslander_renterE/RentersE), Perc_HispanicLatinoOwner = (HispanicLatino_ownerE/OwnersE), Perc_HispanicLationRenterE = (HispanicLation_renterE/RentersE)) %>%
select(1:5, 48:59)
Tenure_perc_by_race <- Tenure_perc_by_race %>%
pivot_longer(., cols = c(Perc_AsianOwners, Perc_WRenters, Perc_WOwners, Perc_BOwners, Perc_BRenters, Perc_NativeAmOwners, Perc_NativeAmRenters, Perc_AsianRenters, Perc_PacificIslanderOwner, Perc_PacificIslanderRenter, Perc_HispanicLatinoOwner, Perc_HispanicLationRenterE), names_to = "Variable", values_to = "Percentage (Estimated)") %>%
mutate(Race = case_when(
str_detect(Variable, "Asian") ~ "Asian",
str_detect(Variable, "B") ~ "Black",
str_detect(Variable, "NativeAm") ~ "Native American",
str_detect(Variable, "PacificIslander") ~ "Pacific Islander",
str_detect(Variable, "Hispanic") ~ "Hispanic or Latino",
str_detect(Variable, "WRenters") ~ "White",
str_detect(Variable, "WOwners") ~ "White"
),
Variable = case_when(
str_detect(Variable, "Owner") ~ "Owner",
str_detect(Variable, "Renter") ~ "Renter"
))
Tenure_perc_by_race <- rename(Tenure_perc_by_race, Tenure_Type = Variable)
Tenure_perc_by_race %>%
filter(Tenure_Type == "Renter" & Race %in% race ) %>%
ggplot(aes(x = Tenure_Type, y = `Percentage (Estimated)`, fill = Race)) +
scale_fill_viridis_d() +
geom_boxplot() +
facet_wrap(~Region) +
labs(title = "Racial Composition of Renters in Charlottesville and Richmond, Virginia", x = "Tenure Type")
Highest rent: Fluvanna, Chesterfield, Henrico and Albemarle Highest median real estate taxes: Albemare, Charlottesville, Richmond, and Chesterfeild
ACS_Housing_Data |>
group_by(County) |>
summarize(Median_rent = median(MedianRentE, na.rm = TRUE), Median_tax = median(MedianTaxesE, na.rm = TRUE), Median_income = median(MedianIncomeE, na.rm = TRUE))
## # A tibble: 11 × 4
## County Median_rent Median_tax Median_income
## <chr> <dbl> <dbl> <dbl>
## 1 Albemarle 1323 2657 55964
## 2 Charlottesville 1181 2622. 40104
## 3 Chesterfield 1333 1935 60040
## 4 Fluvanna 1419 1786 49581
## 5 Greene 974. 1636. 51240.
## 6 Henrico 1214 1923 53133
## 7 Hopewell 910. 1104. 28625
## 8 Louisa 875 1432 46964
## 9 Nelson 918. 1357 44754
## 10 Petersburg City 952 1067 34167
## 11 Richmond City 1085 2148 37975
Highest Rent Tax Ratio: Petersburg City, Chesterfeild, and Nelson
Tenure_and_Housing_Data <- full_join(Tenure_perc_by_race, ACS_Housing_Data, by = "GEOID") %>%
select(1,6:30)
ACS_Housing_Data$RentTaxRatio <- round(ACS_Housing_Data$RentTaxRatio, 3)
Tenure_and_Housing_Data %>%
filter(`Percentage (Estimated)` >= 0.5, Race == "Black", Tenure_Type == "Renter") %>%
group_by(County.y) %>%
summarize(Rent_Tax_RaTio_Black = median(RentTaxRatio, na.rm = TRUE))
## # A tibble: 6 × 2
## County.y Rent_Tax_RaTio_Black
## <chr> <dbl>
## 1 Chesterfield 0.754
## 2 Henrico 0.791
## 3 Hopewell 0.859
## 4 Nelson 0.962
## 5 Petersburg City 0.790
## 6 Richmond City 0.589
Here is a look at the rent to tax ratio (measure of rent exploitation) across both regions
counties <- c("Albemarle", "Charlottesville", "Fluvanna", "Greene", "Louisa", "Nelson", "Richmond city", "Henrico", "Chesterfield", "Hopewell", "Petersburg")
countytracts <- tracts(state = "VA", county = counties, year = 2020)
countytracts <- countytracts |>
mutate(GEOID = as.numeric(countytracts$GEOID))
HousingDataSpatial <- full_join(ACS_Housing_Data, countytracts, by = "GEOID") |>
sf::st_as_sf() |>
mutate(INTPTLAT = as.numeric(countytracts$INTPTLAT), INTPTLON = as.numeric(countytracts$INTPTLON))|>
sf::st_transform(crs = '+proj=longlat +datum=WGS84')
pal <- colorNumeric("YlOrRd", HousingDataSpatial$RentTaxRatio, reverse = TRUE)
HousingDataSpatial %>%
leaflet() %>%
addTiles() %>%
addPolygons(color = "black",
fillColor = ~pal(RentTaxRatio),
fillOpacity = 0.6,
weight = 2,
highlight = highlightOptions(
weight = 3,
fillOpacity = 0.9,
bringToFront = T),
popup = paste0("County: ", HousingDataSpatial$County, "<br>",
"Tract: ", HousingDataSpatial$NAMELSAD, "<br>",
"Rent to Tax Ratio: ", HousingDataSpatial$RentTaxRatio)) %>%
addLegend(pal = pal,
values = ~RentTaxRatio,
opacity = 0.7,
title = "Rent to Tax Ratio (2020)",
position = "bottomleft")
Richmond, Charlottesville and Nelson are the most rent burdened counties, but no counties appear to be severly rent burdened (more than 50), on average.
ACS_Housing_Data %>%
group_by(County) %>%
summarize(Median_perc_rent_income = median(PercRentBurdenE, na.rm = TRUE)) %>%
arrange(desc(Median_perc_rent_income))
## # A tibble: 11 × 2
## County Median_perc_rent_income
## <chr> <dbl>
## 1 Richmond City 32.6
## 2 Charlottesville 31.9
## 3 Hopewell 31.4
## 4 Henrico 28.6
## 5 Albemarle 27.9
## 6 Petersburg City 27.8
## 7 Chesterfield 27.5
## 8 Greene 27
## 9 Louisa 26.6
## 10 Nelson 23.8
## 11 Fluvanna 21.3
Here is a more detailed look at who’s rent burded and severely rent burdened in each County, with Richmond still being the most rent burdened.
ACS_Housing_Data <- ACS_Housing_Data %>%
mutate(Rent_Burdened = case_when(
PercRentBurdenE >= 30 & PercRentBurdenE < 50 ~ "Yes",
PercRentBurdenE >= 50 ~"Yes, Severely",
TRUE ~ "No")
)
Rent_Burden_stats <- ACS_Housing_Data %>%
filter(Rent_Burdened != "No") %>%
group_by(Rent_Burdened, County) %>%
summarize(Percent = round((n()/317)*100, 3)) %>%
arrange(desc(Percent))
knitr::kable(Rent_Burden_stats)
| Rent_Burdened | County | Percent |
|---|---|---|
| Yes | Richmond City | 13.565 |
| Yes | Henrico | 10.095 |
| Yes | Chesterfield | 6.940 |
| Yes | Albemarle | 3.155 |
| Yes | Charlottesville | 2.208 |
| Yes | Petersburg City | 1.262 |
| Yes, Severely | Richmond City | 1.262 |
| Yes | Hopewell | 0.946 |
| Yes | Louisa | 0.946 |
| Yes, Severely | Chesterfield | 0.946 |
| Yes, Severely | Albemarle | 0.315 |
| Yes, Severely | Fluvanna | 0.315 |
| Yes, Severely | Henrico | 0.315 |
| Yes, Severely | Nelson | 0.315 |
As we can see here, although it may not look like it from the numbers above, a lot of counties (the biggest census tracts too) are rent burdened, some even severely.
pal1 <- colorNumeric("YlOrRd", HousingDataSpatial$PercRentBurdenE, reverse = TRUE)
HousingDataSpatial %>%
leaflet() %>%
addTiles() %>%
addPolygons(color = "black",
fillColor = ~pal1(PercRentBurdenE),
fillOpacity = 0.6,
weight = 2,
highlight = highlightOptions(
weight = 3,
fillOpacity = 0.9,
bringToFront = T),
popup = paste0("County: ", HousingDataSpatial$County, "<br>",
"Tract: ", HousingDataSpatial$NAMELSAD, "<br>",
"Percentage of Rent Burden: ", HousingDataSpatial$PercRentBurdenE)) %>%
addLegend(pal = pal1,
values = ~PercRentBurdenE,
opacity = 0.7,
title = "Percentage of Rent Burden (2020)",
position = "bottomleft")
Although these three are the most rent burdened, it isn’t obvious based on its rent to tax ratio and median household income, except for in Nelson county (which only has 5 observations in the tract)
No one county has a disproportionate amount of students compared to the other, however, Richmond, Charlottesville, and Henrico have the highest student populations
ACS_Housing_Data %>%
group_by(County) %>%
summarize(Median_perc_students = median(Perc_StudentsE, na.rm = TRUE))
## # A tibble: 11 × 2
## County Median_perc_students
## <chr> <dbl>
## 1 Albemarle 5.21
## 2 Charlottesville 5.98
## 3 Chesterfield 5.43
## 4 Fluvanna 4.96
## 5 Greene 3.16
## 6 Henrico 5.59
## 7 Hopewell 4.84
## 8 Louisa 3.7
## 9 Nelson 4.96
## 10 Petersburg City 4.8
## 11 Richmond City 6.59
*More than 50% of pop. in tracts in Richmond and Charlottesville city consist of students, but doesn’t seem like the case for Henrico!
perc_student_counties <- c("Richmond City", "Charlottesville", "Henrico")
Moststudents <- HousingDataSpatial %>%
filter(County %in% perc_student_counties)
pal2 <- colorNumeric("YlOrRd", Moststudents$Perc_StudentsE, reverse = TRUE) #the reverse argument reverses the color palette
Moststudents %>%
leaflet() %>%
addTiles() %>%
addPolygons(color = "black",
fillColor = ~pal2(Perc_StudentsE),
weight = 2,
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 3,
fillOpacity = 0.9,
bringToFront = T),
popup = paste0("County: ", Moststudents$County, "<br>",
"Tract: ", Moststudents$NAMELSAD, "<br>",
"Percentage of Students: ", Moststudents$Perc_StudentsE)) %>%
addLegend(pal = pal2,
values = ~Perc_StudentsE,
opacity = 0.7,
title = "Highest Percentage of Students in Charlottesville and Richmond regions for 2020",
position = "bottomleft")
Here’s a detailed look at which census tracts have the most students
HousingDataSpatial %>%
filter(Perc_StudentsE >= 50) %>%
select(3,22) %>%
arrange(desc(Perc_StudentsE))
## Simple feature collection with 8 features and 2 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: -78.52874 ymin: 37.22587 xmax: -77.41441 ymax: 38.05642
## CRS: +proj=longlat +datum=WGS84
## # A tibble: 8 × 3
## NAME.x Perc_StudentsE geometry
## <chr> <dbl> <MULTIPOLYGON [°]>
## 1 Census Tract 403, Richmond city, Vir… 90.5 (((-77.45652 37.54333, -…
## 2 Census Tract 109.04, Albemarle Count… 86.5 (((-78.52864 38.02705, -…
## 3 Census Tract 6, Charlottesville city… 71.9 (((-78.52363 38.0224, -7…
## 4 Census Tract 402.01, Richmond city, … 68.8 (((-77.45534 37.55372, -…
## 5 Census Tract 109.01, Albemarle Count… 65.9 (((-78.52472 38.0483, -7…
## 6 Census Tract 2.02, Charlottesville c… 60.4 (((-78.50342 38.03681, -…
## 7 Census Tract 1006, Chesterfield Coun… 60.4 (((-77.43459 37.23137, -…
## 8 Census Tract 305.01, Richmond city, … 54.9 (((-77.44895 37.54312, -…
Poverty_By_Race %>%
group_by(County) %>%
summarize(Median_perc_below_poverty = median(Perc_Total_BelowPovertyE, na.rm = TRUE), Median_Gini_Index = median(Gini_IndexE, na.rm = TRUE))
## # A tibble: 11 × 3
## County Median_perc_below_poverty Median_Gini_Index
## <chr> <dbl> <dbl>
## 1 Albemarle 5.71 0.428
## 2 Charlottesville 15.3 0.480
## 3 Chesterfield 5.39 0.356
## 4 Fluvanna 3.76 0.407
## 5 Greene 9.22 0.390
## 6 Henrico 7.54 0.394
## 7 Hopewell 27.8 0.439
## 8 Louisa 10.6 0.426
## 9 Nelson 12.9 0.452
## 10 Petersburg City 22.1 0.437
## 11 Richmond City 17.7 0.448
Here’s a closer look at the Gini Index and the percentage of those below the poverty level in each coutny.
Poverty_Stats <- Poverty_By_Race %>%
filter(Gini_IndexE >= 0.5 & Perc_Total_BelowPovertyE >= 0.5) %>%
select(3,4,36,50) %>%
arrange(desc(Gini_IndexE))
knitr::kable(Poverty_Stats)
| NAME | County | Gini_IndexE | Perc_Total_BelowPovertyE |
|---|---|---|---|
| Census Tract 201.03, Fluvanna County, Virginia | Fluvanna | 0.7173 | 6.53 |
| Census Tract 403, Richmond city, Virginia | Richmond City | 0.7044 | 66.57 |
| Census Tract 305.01, Richmond city, Virginia | Richmond City | 0.6917 | 58.62 |
| Census Tract 6, Charlottesville city, Virginia | Charlottesville | 0.6686 | 63.91 |
| Census Tract 404, Richmond city, Virginia | Richmond City | 0.6400 | 39.70 |
| Census Tract 207, Richmond city, Virginia | Richmond City | 0.6393 | 21.24 |
| Census Tract 7, Charlottesville city, Virginia | Charlottesville | 0.6153 | 21.08 |
| Census Tract 2008.05, Henrico County, Virginia | Henrico | 0.6129 | 32.49 |
| Census Tract 1009.38, Chesterfield County, Virginia | Chesterfield | 0.6044 | 0.79 |
| Census Tract 9501.02, Nelson County, Virginia | Nelson | 0.5953 | 17.73 |
| Census Tract 2009.08, Henrico County, Virginia | Henrico | 0.5929 | 8.58 |
| Census Tract 405, Richmond city, Virginia | Richmond City | 0.5811 | 14.40 |
| Census Tract 104.01, Albemarle County, Virginia | Albemarle | 0.5762 | 5.29 |
| Census Tract 210, Richmond city, Virginia | Richmond City | 0.5745 | 30.86 |
| Census Tract 204, Richmond city, Virginia | Richmond City | 0.5731 | 50.49 |
| Census Tract 8107, Petersburg city, Virginia | Petersburg City | 0.5605 | 22.63 |
| Census Tract 413, Richmond city, Virginia | Richmond City | 0.5551 | 17.66 |
| Census Tract 2.02, Charlottesville city, Virginia | Charlottesville | 0.5448 | 57.51 |
| Census Tract 109.01, Albemarle County, Virginia | Albemarle | 0.5433 | 29.63 |
| Census Tract 412, Richmond city, Virginia | Richmond City | 0.5417 | 32.50 |
| Census Tract 109.04, Albemarle County, Virginia | Albemarle | 0.5407 | 29.15 |
| Census Tract 4.01, Charlottesville city, Virginia | Charlottesville | 0.5317 | 18.69 |
| Census Tract 209, Richmond city, Virginia | Richmond City | 0.5309 | 8.30 |
| Census Tract 710.04, Richmond city, Virginia | Richmond City | 0.5306 | 50.90 |
| Census Tract 2010.03, Henrico County, Virginia | Henrico | 0.5291 | 18.17 |
| Census Tract 505, Richmond city, Virginia | Richmond City | 0.5284 | 2.57 |
| Census Tract 605.02, Richmond city, Virginia | Richmond City | 0.5225 | 8.58 |
| Census Tract 10, Charlottesville city, Virginia | Charlottesville | 0.5205 | 7.69 |
| Census Tract 101, Albemarle County, Virginia | Albemarle | 0.5178 | 6.29 |
| Census Tract 1009.26, Chesterfield County, Virginia | Chesterfield | 0.5125 | 1.94 |
| Census Tract 501, Richmond city, Virginia | Richmond City | 0.5099 | 8.22 |
| Census Tract 112.01, Albemarle County, Virginia | Albemarle | 0.5060 | 6.02 |
| Census Tract 8106, Petersburg city, Virginia | Petersburg City | 0.5018 | 36.43 |
| Census Tract 102.01, Richmond city, Virginia | Richmond City | 0.5017 | 7.02 |
| Census Tract 8113, Petersburg city, Virginia | Petersburg City | 0.5014 | 34.61 |
| Census Tract 109, Richmond city, Virginia | Richmond City | 0.5013 | 21.20 |
PovertyBy_Race_County <- Poverty_By_Race %>%
group_by(County) %>%
summarize(Median_Perc_WBelowPoverty = median((Perc_BelowPoverty_WhiteE), na.rm = TRUE), Median_Perc_BBelowPoverty = median((Perc_BelowPoverty_BlackE), na.rm = TRUE), Median_Perc_NativeAm_BelowPoverty = median((Perc_BelowPoverty_NativeAmE), na.rm = TRUE), Median_Perc_Asian_BelowPoverty = median((Perc_BelowPoverty_AsianE), na.rm = TRUE), Median_Perc_PacificIslander_BelowPoverty = median((Perc_BelowPoverty_PacificIslanderE), na.rm = TRUE), Median_Perc_HispanicLatino_BelowPoverty = median((Perc_BelowPoverty_HispanicLatinoE), na.rm = TRUE))
knitr::kable(PovertyBy_Race_County)
| County | Median_Perc_WBelowPoverty | Median_Perc_BBelowPoverty | Median_Perc_NativeAm_BelowPoverty | Median_Perc_Asian_BelowPoverty | Median_Perc_PacificIslander_BelowPoverty | Median_Perc_HispanicLatino_BelowPoverty |
|---|---|---|---|---|---|---|
| Albemarle | 5.670 | 0.840 | 0.00 | 0.00 | 0 | 0.460 |
| Charlottesville | 11.020 | 14.575 | 0.00 | 19.48 | 0 | 17.900 |
| Chesterfield | 4.140 | 5.320 | 0.00 | 0.00 | 0 | 4.420 |
| Fluvanna | 3.730 | 3.690 | 0.00 | 0.00 | 0 | 0.000 |
| Greene | 6.595 | 9.340 | 0.00 | 2.38 | NA | 8.390 |
| Henrico | 5.860 | 7.080 | 0.00 | 0.00 | 0 | 0.865 |
| Hopewell | 20.820 | 33.050 | 0.00 | 0.00 | NA | 30.635 |
| Louisa | 9.000 | 20.730 | 0.00 | 0.00 | NA | 0.000 |
| Nelson | 4.500 | 2.750 | NA | 50.00 | NA | 0.000 |
| Petersburg City | 12.140 | 23.000 | 47.22 | 8.74 | 0 | 1.780 |
| Richmond City | 9.200 | 24.690 | 0.00 | 26.92 | 0 | 12.545 |
Here is a measure of the Exposure, via the Isolation Index of Black groups
#
HDSpatial_Updated <- HousingDataSpatial %>%
mutate(county_tract = paste(COUNTYFP,TRACTCE, sep = ""))
#
cvl_rva_measures_Spatial <- full_join(cvl_rva_measures, HDSpatial_Updated, by = "county_tract") %>%
sf::st_as_sf() |>
sf::st_transform(crs = 4326)
#
pal3 <- colorNumeric("viridis", cvl_rva_measures_Spatial$iso_b_block, reverse = TRUE)
cvl_rva_measures_Spatial %>%
leaflet() %>%
addTiles() %>%
addPolygons(color = "black",
fillColor = ~pal3(iso_b_block),
fillOpacity = 0.6,
weight = 2,
highlight = highlightOptions(
weight = 3,
fillOpacity = 0.9,
bringToFront = T),
popup = paste0("County: ", cvl_rva_measures_Spatial$County, "<br>",
"Tract: ", cvl_rva_measures_Spatial$NAME.x, "<br>",
"Isolation Index: ", cvl_rva_measures_Spatial$iso_b_block)) %>%
addLegend(pal = pal3,
values = ~iso_b_block,
opacity = 0.7,
title = "Black Isolation Index (2020)",
position = "bottomleft")
Here is a measure of Evenness, via the Dissimilarity Index between White and Black Groups
pal4 <- colorNumeric("viridis", cvl_rva_measures_Spatial$dissim_wb_block, reverse = TRUE)
cvl_rva_measures_Spatial %>%
leaflet() %>%
addTiles() %>%
addPolygons(color = "black",
fillColor = ~pal4(dissim_wb_block),
fillOpacity = 0.6,
weight = 2,
highlight = highlightOptions(
weight = 3,
fillOpacity = 0.9,
bringToFront = T),
popup = paste0("County: ", cvl_rva_measures_Spatial$County, "<br>",
"Tract: ", cvl_rva_measures_Spatial$NAME.x, "<br>",
"Dissimilarity Index: ", cvl_rva_measures_Spatial$dissim_wb_block)) %>%
addLegend(pal = pal4,
values = ~dissim_wb_block,
opacity = 0.7,
title = "Whtie and Black Dissimilarity Index (2020)",
position = "bottomleft")
Tenure_and_Housing_Data %>%
filter(Tenure_Type == "Renter" & Race %in% race) %>%
ggplot(aes(x = `Percentage (Estimated)`, y = RentTaxRatio, color = Region.y)) +
geom_point(alpha = 0.3) +
geom_smooth(method = "lm") +
facet_wrap(~Race) +
labs(title = "Demographic of Renter vs Rent Exploitation in Charlottesville and Richmond, VA", x = "Percentage of Renter (Estimated)", y = "Rent to Tax Ratio", color = "Region")
#Below is the Linear Model Coefficient
lm1 <- lm(RentTaxRatio ~ `Percentage (Estimated)`:factor(Race), data = Tenure_and_Housing_Data)
lm1
##
## Call:
## lm(formula = RentTaxRatio ~ `Percentage (Estimated)`:factor(Race),
## data = Tenure_and_Housing_Data)
##
## Coefficients:
## (Intercept)
## 0.6365
## `Percentage (Estimated)`:factor(Race)Asian
## -0.2752
## `Percentage (Estimated)`:factor(Race)Black
## 0.1288
## `Percentage (Estimated)`:factor(Race)Hispanic or Latino
## 0.5291
## `Percentage (Estimated)`:factor(Race)Native American
## -0.2271
## `Percentage (Estimated)`:factor(Race)Pacific Islander
## 2.1519
## `Percentage (Estimated)`:factor(Race)White
## -0.0360
#Graph
Tenure_and_Housing_Data %>%
filter(Tenure_Type == "Renter" & Race %in% race) %>%
ggplot(aes(x = `Percentage (Estimated)`, y = PercRentBurdenE, color = Region.y)) +
scale_color_viridis_d() +
geom_point(alpha = 0.3) +
geom_smooth(method = "lm") +
facet_wrap(~Race) +
labs(title = "Demographic of Renter vs Rent Burden in CVL and RVA", x = "Percentage of Renter (Estimated)", y = "Rent as a Percentage of Income", color = "Region")
#Below is the Linear Model Coefficient
lm3 <- lm(PercRentBurdenE ~ Race:`Percentage (Estimated)`, data = Tenure_and_Housing_Data)
lm3
##
## Call:
## lm(formula = PercRentBurdenE ~ Race:`Percentage (Estimated)`,
## data = Tenure_and_Housing_Data)
##
## Coefficients:
## (Intercept)
## 30.431
## RaceAsian:`Percentage (Estimated)`
## -3.197
## RaceBlack:`Percentage (Estimated)`
## 3.336
## RaceHispanic or Latino:`Percentage (Estimated)`
## 4.721
## RaceNative American:`Percentage (Estimated)`
## 44.182
## RacePacific Islander:`Percentage (Estimated)`
## -46.827
## RaceWhite:`Percentage (Estimated)`
## -1.090
Tenure_and_Housing_Data %>%
ggplot(aes(x = PercRentBurdenE, y = RentTaxRatio)) +
geom_point(alpha = 0.3) +
geom_smooth(method = "lm") +
facet_wrap(~Region.y)
#Below is the Linear Model Coefficient
lm5 <- lm(RentTaxRatio ~ PercRentBurdenE:Region.y, data = Tenure_and_Housing_Data)
lm5
##
## Call:
## lm(formula = RentTaxRatio ~ PercRentBurdenE:Region.y, data = Tenure_and_Housing_Data)
##
## Coefficients:
## (Intercept)
## 5.740e-01
## PercRentBurdenE:Region.yCharlottesville
## -3.710e-06
## PercRentBurdenE:Region.yRichmond
## 2.836e-03
Poverty_By_Race %>%
ggplot(aes(x = Perc_Total_BelowPovertyE, y = Gini_IndexE)) +
geom_point(alpha = 0.3) +
geom_smooth(method = "lm") +
facet_wrap(~Region)
#Below is the Linear Model formula
lm(Gini_IndexE ~ Perc_Total_BelowPovertyE:Region, data = Poverty_By_Race)
##
## Call:
## lm(formula = Gini_IndexE ~ Perc_Total_BelowPovertyE:Region, data = Poverty_By_Race)
##
## Coefficients:
## (Intercept)
## 0.38046
## Perc_Total_BelowPovertyE:RegionCharlottesville
## 0.00451
## Perc_Total_BelowPovertyE:RegionRichmond
## 0.00250
#The Dissimilarity Index (Between White and Black)
cvl_rva_measures_Spatial %>%
ggplot(aes(x = dissim_wb_block, y = RentTaxRatio)) +
geom_point(alpha = 0.3) +
geom_smooth(method = "lm") +
facet_wrap(~Region)
lm(RentTaxRatio ~ dissim_wb_block:Region, data = cvl_rva_measures_Spatial) #-0.4407
##
## Call:
## lm(formula = RentTaxRatio ~ dissim_wb_block:Region, data = cvl_rva_measures_Spatial)
##
## Coefficients:
## (Intercept) dissim_wb_block:RegionCharlottesville
## 0.8106 -0.5066
## dissim_wb_block:RegionRichmond
## -0.3735
#The (Black) Isolation Index
cvl_rva_measures_Spatial %>%
ggplot(aes(x = iso_b_block, y = RentTaxRatio)) +
geom_point(alpha = 0.3) +
geom_smooth(method = "lm") +
facet_wrap(~Region)
lm(RentTaxRatio ~ iso_b_block:Region, data = cvl_rva_measures_Spatial) #0.3226
##
## Call:
## lm(formula = RentTaxRatio ~ iso_b_block:Region, data = cvl_rva_measures_Spatial)
##
## Coefficients:
## (Intercept) iso_b_block:RegionCharlottesville
## 0.5246 0.2395
## iso_b_block:RegionRichmond
## 0.3164